home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / comm / www / IBSearch.lha / IBSearch.ibrx next >
Encoding:
Text File  |  2000-04-11  |  11.3 KB  |  440 lines
  1. /* $VER:    IBSearch.ibrx 1.00 2000
  2.    Copyright © 2000 Brian Scott
  3.    Email: bscott@odyssey.apana.org.au
  4.  
  5.    IBSearch.ibrx provides simple searching (optional case sensitive) of 
  6.    either IBrowse's GlobalCache, hotlist or GlobalHistory. It can also
  7.    search the hotlist for the current url. Only hotlist searching is
  8.    available for IBrowseV2+.
  9. */
  10.  
  11. /* Set path to IBrowse */
  12. Cdir = ""
  13. /* Cdir = "IBrowse:" */
  14.  
  15. OPTIONS results
  16. addlib('rexxsupport.library',0,-30,0)
  17.  
  18. call setdefaults()
  19. call buildgui()
  20.  
  21. do while ~eof(ca)
  22.    CALL topipe('con')
  23.    in = readln(ca)
  24.    parse var in in1 in2 in3 in4 in5 ; in5 = strip(in5,'b')
  25.    if in1 = "gadget" then CALL gadgets()
  26.    if in1 = "close" then CALL doenv()
  27.    end
  28.  
  29. EXIT
  30.  
  31. gadgets:
  32. select
  33.   when (in2=9)  then CALL findcurl()
  34.   when (in3=16) & (in5 ~="") then CALL loadIB(nstr.in5)
  35.   when (in2=8) & (in3 ~="") & (srchfile = sfile.HLfile) then do
  36.      if strok(in3, Cresvdtxt) then do
  37.         CALL topipe('id 0 s 256')
  38.         CALL srchhotlist(in3)
  39.         CALL topipe('id 0 s 512')
  40.         end
  41.      end
  42.   when (in2=8) & (in3 ~="") & (srchfile = sfile.GCfile) then do
  43.      if strok(in3, Hresvdtxt) then do
  44.         CALL topipe('id 0 s 256')
  45.         CALL srchche(in3)
  46.         CALL topipe('id 0 s 512')
  47.         end
  48.      end
  49.   when (in2=8) & (in3 ~="") & (srchfile = sfile.GHfile) then do
  50.      CALL topipe('id 0 s 256')
  51.      CALL srchghlist(in3)
  52.      CALL topipe('id 0 s 512')
  53.      end
  54.   when (in2=5) then srchfile = sfile.in3
  55.   when (in2=6) then do
  56.      case=in3
  57.      tmp=topipe('id 'casebut' gt "'"Case "||cbtxt.case'"')
  58.      end
  59.  otherwise NOP
  60.    end
  61. tmp=topipe('id 'srchid' s 400')
  62. RETURN
  63.  
  64. setdefaults:
  65. if Cdir="" then do
  66.    Cdir = IBexists()
  67.    if Cdir="" then do
  68.       CALL showmsg("Can''t find IBrowse!", "See readme for script placement instructions.")
  69.       EXIT
  70.       end
  71.    end
  72. ver2=0
  73. if IBver() > 20 then ver2=1
  74.  
  75. LF = '0a'x
  76.  
  77. envfile="env:_IBSearch.env"
  78. HLfile=0; GCfile=1; GHfile=2
  79. sfile.GCfile = Cdir||"Cache/GlobalCache"
  80. sfile.HLfile = Cdir||"ibrowse-hotlist.html"
  81. sfile.GHfile = Cdir||"GlobalHistory"
  82.  
  83. case = 0
  84. srchtxt = ""
  85. filechoice = 0
  86. windowdef= 'width' 400 'height' 133
  87. if open('env',envfile,'r') then do
  88.    windowt=readln('env')
  89.    parse var windowt wl wt ww wh .
  90.    if (datatype(wt,N) &datatype(wl,N) &datatype(ww,N) & datatype(wh,N) ) then
  91.       windowdef= 'top' wt 'left' wl 'width' ww 'height' wh
  92.    ln=readln('env')
  93.    if EOF('env') then do; close('env'); BREAK; end
  94.    if datatype(ln,N) then filechoice=ln
  95.    ln=readln('env')
  96.    if EOF('env') then do; close('env'); BREAK; end
  97.    if datatype(ln,N) then case=ln
  98.    CALL close('env')
  99.    end
  100.  
  101. srchfile  = sfile.filechoice
  102.  
  103. cbtxt.0 = "Off"
  104. cbtxt.1 = "On "
  105. maxstr = 65535
  106. Z      = D2C(0)
  107. Cresvdtxt = 'TEXT/PLAIN.HTML.JPEG.IMAGE.PNG or a number.'
  108. Hresvdtxt = 'BHLFLAGS=NOMENU or a number.'
  109. font="Helvetica.font"; fsize="11"
  110. RETURN
  111.  
  112. doenv:
  113. if open('w',envfile,'w') then do
  114.   call writeln(ca,'id 0 read')
  115.   windowr=readln(ca)
  116.   CALL writeln('w',windowr)
  117.   call writeln(ca,'id 'file2srch' read')
  118.   filechoice=readln(ca)
  119.   CALL writeln('w',filechoice)
  120.   call writeln(ca,'id 'casebut' read')
  121.   case=readln(ca)
  122.   CALL writeln('w',case)
  123.   CALL close('w')
  124.   end
  125. RETURN
  126.  
  127. strok:
  128. parse arg tst, resvdtxt
  129. ok=1
  130. if (pos(upper(tst),resvdtxt)>0) | datatype(tst,'N') then do
  131.    ok=0; CALL showmsg("Entered one of these reserved texts..", resvdtxt)
  132.    tmp=topipe('id 'srchid' gt ""')
  133.    end
  134. RETURN ok
  135.  
  136. srchghlist:
  137. parse arg srchstr
  138. ostr=srchstr
  139.  
  140. if ~open('r',srchfile,'r') then do
  141.    CALL showmsg("Can't open..", srchfile)
  142.    RETURN
  143.    end
  144. chunk = readch('r',maxstr)
  145. CALL close('r')
  146.  
  147. eov=pos(LF,chunk)
  148. chunk=right(chunk,length(chunk)-eov)
  149. if case then sstrpos = pos(srchstr,chunk) /* Case sensitive */
  150. else do
  151.    Uchunk = upper(chunk); srchstr = upper(srchstr)
  152.    sstrpos = pos(srchstr,Uchunk)
  153.    end
  154.  
  155. if (sstrpos = 0) then do
  156.    lft = left(left(ostr,58),60,".")
  157.    parse var lft str" " .
  158.    CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  159.    RETURN
  160.    end
  161.  
  162. cntr = 0
  163. if case then do
  164.    do while sstrpos ~=0
  165.       Ltargt = lastpos(" ",chunk,sstrpos); Rtargt = pos(LF,chunk,sstrpos)
  166.       ln=substr(chunk,Ltargt,(Rtargt-Ltargt))
  167.       parse var ln " "url(LF)
  168.       if pos(srchstr,url) >0 then do
  169.          cntr = cntr +1; url.cntr = url
  170.          end
  171.       sstrpos = pos(srchstr,chunk,Rtargt)
  172.       end
  173.    end
  174. else do
  175.    do while sstrpos ~=0
  176.       Ltargt = lastpos(" ",Uchunk,sstrpos); Rtargt = pos(LF,Uchunk,sstrpos)
  177.       ln=substr(chunk,Ltargt,(Rtargt-Ltargt))
  178.       parse var ln " "url(LF)
  179.       if pos(srchstr,upper(url)) >0 then do
  180.          cntr = cntr +1; url.cntr = url
  181.          end
  182.       sstrpos = pos(srchstr,Uchunk,Rtargt)
  183.       end
  184.    end
  185.  
  186. if cntr = 0 then do
  187.    lft = left(left(ostr,58),60,".")
  188.    parse var lft str" " .
  189.    CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  190.    RETURN
  191.    end
  192. else do
  193.    call topipe('id 'lbid' removenode')
  194.    tmp=topipe('id 'lbid' s 0')
  195.    tmp=topipe('id 'lbid' list 0')
  196.    do i = 1 to cntr
  197.       nn=topipe('id 'lbid' Addnode gt "'url.i'"'); nstr.nn = url.i
  198.       end
  199.    lft = left(left(ostr,19),21,".")
  200.    parse var lft dbstr" " .
  201.    tmp=topipe('id 'lbid' list 1')
  202.    tmp=topipe('id 0 s 8 gt "'''||dbstr||''' found in GlobalHist"')
  203.    end
  204. RETURN
  205.  
  206. srchche:
  207. parse arg srchstr
  208. ostr=srchstr
  209. if ~open('r',srchfile,'r') then do
  210.    CALL showmsg("Can't open..", srchfile)
  211.    RETURN
  212.    end
  213. chunk = readch('r',maxstr)
  214. CALL close('r')
  215.  
  216. if case then sstrpos = pos(srchstr,chunk) /* Case sensitive */
  217. else do
  218.    Uchunk = upper(chunk); srchstr = upper(srchstr)
  219.    sstrpos = pos(srchstr,Uchunk)
  220.    end
  221.  
  222. if (sstrpos = 0) then do
  223.    lft = left(left(ostr,58),60,".")
  224.    parse var lft str" " .
  225.    CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  226.    RETURN
  227.    end
  228.  
  229. adjurl = ""
  230. call topipe('id 'lbid' removenode')
  231. tmp=topipe('id 'lbid' s 0')
  232. tmp=topipe('id 'lbid' list 0')
  233. do while sstrpos > 0
  234.    LZ = lastpos(Z,chunk,sstrpos); RZ = pos(Z,chunk,sstrpos)
  235.    fullurl = substr(chunk,LZ+1,(RZ-LZ)-1); adjurl = fullurl
  236.  
  237.    last7 = upper(right(fullurl,7))
  238.    parse var last7 "." extens
  239.    extens = "."||extens
  240.    if (extens = ".") | (pos(extens,".GIF.JPG.HTML.SHTML") = 0) then do
  241.       parse var chunk +RZ cacheNo (Z) mtype (Z)
  242.       adjurl = adjurl||"  ("||mtype||")"
  243.       end
  244.  
  245.    nn=topipe('id 'lbid' Addnode gt "'adjurl'"'); nstr.nn = fullurl
  246.    if case then sstrpos = pos(srchstr,chunk,RZ)
  247.    else sstrpos = pos(srchstr,Uchunk,RZ)
  248.    end
  249.  
  250. lft = left(left(ostr,19),21,".")
  251. parse var lft dbstr" " .
  252. tmp=topipe('id 'lbid' list 1')
  253. tmp=topipe('id 0 s 8 gt "'''||dbstr||''' found in Cache"')
  254. RETURN
  255.  
  256. srchhotlist:
  257. parse arg srchstr
  258. ostr=srchstr
  259.  
  260. if ~open('r',srchfile,'r') then do
  261.    CALL showmsg("Can't open..", srchfile)
  262.    RETURN
  263.    end
  264. chunk = readch('r',maxstr)
  265. CALL close('r')
  266.  
  267. cntr = 0
  268. UZL = '><'
  269. UZQ = '"'
  270. DZL = '>'
  271. DZR = '</A>'
  272.  
  273. startat=pos("</B><UL>",chunk); endat=lastpos("</UL>",chunk)
  274. chunk = substr(chunk,startat,endat-startat)
  275.  
  276. if case then do   /* Case sensitive */
  277.    sstrpos = pos(srchstr,chunk)
  278.    if (sstrpos = 0) then do
  279.       lft = left(left(srchstr,58),60,".")
  280.       parse var lft str" " .
  281.       CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  282.       RETURN
  283.       end
  284.    do while sstrpos >0
  285.       LZ = lastpos(UZL,chunk,sstrpos); RZ = pos(LF,chunk,sstrpos)
  286.       ln = substr(chunk,LZ,(RZ-LZ))
  287.       parse var ln (UZQ)url(UZQ) . (DZL)dis(DZR)
  288.       tndstr = url||" ("||dis||")"
  289.       if pos(srchstr,tndstr) > 0 then do
  290.           cntr=cntr +1; ndstr.cntr = tndstr; rurl.cntr=url
  291.           end
  292.       sstrpos = pos(srchstr,chunk,RZ)
  293.       end
  294.    end
  295. else do
  296.    Uchunk = upper(chunk); srchstr = upper(srchstr)
  297.    sstrpos = pos(srchstr,Uchunk)
  298.    if (sstrpos = 0) then do
  299.       lft = left(left(ostr,58),60,".")
  300.       parse var lft str" " .
  301.       CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  302.       RETURN
  303.       end
  304.    do while sstrpos >0
  305.       LZ = lastpos(UZL,Uchunk,sstrpos); RZ = pos(LF,Uchunk,sstrpos)
  306.       ln = substr(chunk,LZ,(RZ-LZ))
  307.       parse var ln (UZQ)url(UZQ) . (DZL)dis(DZR)
  308.       tndstr = url||" ("||dis||")"
  309.       if pos(srchstr,upper(tndstr)) > 0 then do
  310.           cntr=cntr +1; ndstr.cntr = tndstr; rurl.cntr=url
  311.           end
  312.       sstrpos = pos(srchstr,Uchunk,RZ)
  313.       end
  314.    end
  315.  
  316. if cntr >0 then do
  317.    call topipe('id 'lbid' removenode')
  318.    tmp=topipe('id 'lbid' s 0')
  319.    tmp=topipe('id 'lbid' list 0')
  320.    do i = 1 to cntr
  321.       nn=topipe('id 'lbid' Addnode gt "'ndstr.i'"'); nstr.nn = rurl.i
  322.       end
  323.    lft = left(left(ostr,19),21,".")
  324.    parse var lft dbstr" " .
  325.  
  326.    tmp=topipe('id 'lbid' list 1')
  327.    tmp=topipe('id 0 s 8 gt "'''||dbstr||''' found in hotlist"')
  328.    end
  329. else do
  330.    lft = left(left(str,58),60,".")
  331.    parse var lft str" " .
  332.    CALL showmsg("With Case "||cbtxt.case||" can't find..", "'"||str||"'")
  333.    RETURN
  334.    end
  335. RETURN
  336.  
  337. findcurl:
  338. if ~Show("P","IBROWSE") then do
  339.    CALL showmsg("Error!", "Requires IBrowse to be running!")
  340.    RETURN
  341.    end
  342. cursf=srchfile
  343. address "IBROWSE"
  344. 'QUERY URL'
  345. in3=result; in2=8; srchfile=sfile.HLfile
  346. CALL gadgets()
  347. srchfile=cursf
  348. RETURN
  349.  
  350. loadIB: procedure expose Cdir
  351. parse arg URL
  352. if ~Show("P","IBROWSE") then do
  353.    address command "run "||Cdir||"IBrowse"
  354.    CALL DELAY(800)
  355.    end
  356. address "IBROWSE"
  357. 'GotoURL "'URL'"'
  358. RETURN
  359.  
  360. buildgui:
  361. CALL open(ca,"awnpipe:Search/xc")
  362. tmp=topipe('title "IBrowse Cache and HotList searcher." defg v a si m sw ps IBROWSE 'windowdef'')  
  363. fontid=topipe('TextAttr gt "'font'" defn 'fsize'')
  364.  
  365. lbid=topipe('listbrowser font 'fontid' minw 403 minh 50 arrows')
  366. tmp=topipe('layout weih 0')
  367. tmp=topipe('layout v si weih 0 weiw 0 font 'fontid'')
  368.  
  369. if ~ver2 then file2srch=topipe('chooser pu s 'filechoice' cl "HotList|Cache|GlobalHist"')
  370. else file2srch=topipe('chooser maxn 1 pu cl "HotList|Cache|GlobalHist"')
  371. casebut=topipe('button pb s 'case' gt "'"Case "||cbtxt.case'" weih 0')
  372. tmp=topipe('le')
  373. tmp=topipe('layout v si')
  374. tmp=topipe('label  gt "Search for:" ua font 'fontid'')
  375. srchid=topipe('string gt "'srchtxt'" lj minc 20 chl')
  376. srchbut=topipe('button gt "Find current URL in hotlist" weih 0 font 'fontid'')
  377. tmp=topipe('le')
  378. tmp=topipe('le')
  379. tmp=topipe("open")
  380. tmp=topipe('id 'srchid' s 400')
  381. RETURN
  382.  
  383. topipe:
  384. /* this routine does error checking on lines written to pipe.*/
  385.  
  386. /*get line to output*/
  387. parse arg out
  388.  
  389. /* write to the pipe*/
  390. call writeln(ca,out)
  391.  
  392. /*get responce and parse it.*/
  393. res=readln(ca)
  394. parse var res res1 res2 .
  395.  
  396. /* if all is ok return the second part of the responce (usualy the GID)*/
  397. if res1='ok' then return(res2)
  398.  
  399. /* something went wrong, we notify the user then exit */
  400. /*show problem line and responce (reponce may be just a blank line)*/
  401. CALL showmsg(res, compress(out,LF'"'''CR))
  402. EXIT
  403.  
  404. IBexists: procedure
  405. PARSE SOURCE . . . src .
  406. rt = ""
  407. osrc = src; src = UPPER(src)
  408. strt=length(src)
  409. rxp=POS('REXX/',src); if rxp>0 then strt=rxp
  410. flpos=MAX(LASTPOS(':',src,strt),LASTPOS('/',src,strt))
  411. parse var osrc progdir +flpos nm
  412. if exists(progdir||"IBrowse") then rt=progdir
  413. RETURN rt
  414.  
  415. IBver: procedure expose Cdir
  416. CALL open('ibr',Cdir||"IBrowse",'r')
  417. IBchunk=readch('ibr',65000)
  418. CALL close('ibr')
  419. parse var IBchunk "$VER:" ib ver .
  420. RETURN ver
  421.  
  422. showmsg:
  423. parse arg ttle, errtxt
  424. wd = length(ttle)*10
  425. le=(length(errtxt)*9)+3
  426. if le>wd then wd=le
  427. CALL open('caE',"awnpipe:Error/xc")
  428. call writeln('caE','"'ttle'" ps IBROWSE db a so v width 'wd'')
  429. call writeln('caE','layout so b 0 v cj gt " 'errtxt' "')
  430. call writeln('caE','layout cj b 0 weiw 0')
  431. call writeln('caE','button cj gt " _OK  " c')
  432. call writeln('caE','le')
  433. call writeln('caE','le')
  434. call writeln('caE','open')
  435. do while ~eof('caE')
  436.    in = readln('caE')
  437.    end
  438. CALL close('caE')
  439. RETURN
  440.